00002	C  QUAD CALL MUST BE IN 1ST OF 5 PARAMS.  QUAD MUST BE FOLLOWED
00008	C   BY SPC, / OR ;.  OTHER CALLS SUCH AS MOVE,NUM ETC. CAN
00014	C   APPEAR BEFORE  / OR ;, BUT "ALL" MUST! APPEAR 
00020	C   BEFORE! QUAD (IF USED).
00026	C  *** THE 5TH PARAM MUST NOT!! BE LISTED AT ALL IN YOUR SCORE!!! ****
00032	C  ADD AN "F" TO QUAD FOR FUNCTIONS, AN "X" FOR X,Y COORDS.
00038	C BASIC QUAD PRODUCES CIRCLES. /DEGS/RADIUS/CENT. X/CENT. Y/
00044	C  QUADX -- /X /Y / (5TH PARAM WILL ALWAYS BE WASTED)
00050	CC43611	IF(N.NE.'Q'.OR.INP(JD+1).NE.'U')GO TO 4361
00056	CC	QX=-13.
00062	CC	DO 43612 N=JD,72
00068	CC	J=INP(N)
00074	CC	IF(J.EQ.IXX)QX=QX-1.
00080	CC	IF(J.EQ.IF)QX=QX-2.
00100		SUBROUTINE QUAD(NL)
00200		COMMON P(30),INUM,IPAR,CNT(27),BT,PL(48),IREST,DF,DUR(27)
00300	C   INUM=INST#  IPAR=PARAM#  
00320	C   BT=BASIC TIME P1 WHEN SUBROUTINE IS CALLED
00400	C   IF IREST IS <0, THAT NOTE WILL BE A REST.  
00500	C   INST=INST. NAME,  BG=INSTS' BEGIN TIMES.
00600	C   NOTE #S IN SUBROUTINE: (1-84)  
00620	C   C4=37  FS4=43  C5=49  ETC.    F1=86  F15=100 (NO F16!)
00700	
00800		DIMENSION F(5,512),IP(1),ISU(1400),ALF(4),IPATH(2,512),
00820		1 ICA(4),ICB(4),ARY(9),IDOP(4,5)
00900	       DATA ICA/-106,90,90,-106/,IDOP/-108,406,168,406,
00950		1 -88,466,-88,346,  -24,376,-24,436,  40,376,40,436,
01000		1 104,376,104,436/, ICB/90,90,-106,-106/,ALF/'A','B','C','D'/
01050		1 , ARY/45H(' ARRAY F',I2,'(512); SEG(F',I2,');0  999')  /
01055	C  /DEG OR X/DIS OR Y/CEN OF CIRC X/CEN OF CIRCLE Y/(CALLS QUAD)/
01200		IF(CNT(INUM).GT.1.)GO TO 1
01400		L=0
01420		ARY(3)=5H',I1,
01460		ARY(7)=5HI1,')
01500		NJ=IPAR-4
01525		XF=999.
01550		DIF=0
01575		DURFAC=(DUR(INUM)-P(1))/512.+.000001
01587	C  WON'T CREATE FUNCS OF DPY FOR MORE THAN 1 INST
01595	1	CALL QUADO(P,IPAR,NL,XF,YF)
01600		DIF=DIF+P(2)
01610		IF(DIF)RETURN
01620	C   GET ANOTHER NNTE FOR THIS FUNC. SLOT
01630	3	L=L+1
01800		M=0
01900		DO 4 K=NJ,IPAR
02000		M=M+1
02100	4	F(M,L)=P(K)
02200		IPATH(1,L)=XF*10.
02300		IPATH(2,L)=YF*10.
02400		IF(L.EQ.512)GO TO 2
02410		DIF=DIF-DURFAC
02420		IF(DIF.GE.0)GO TO 3
02430	C   USE ANOTHER FUNC. SLOT FOR THIS NOTE
02440		RETURN
02450	C   DUR SHOULD BE SET CLOSE TO "TRUE" DUR.
02500	2	CALL DPYSET(1,ISU,1400)
02600		CALL DPYBRT(2)
02610		IT=-460
02620		IB=-495
02630	999	I=0
02700		CALL TYPLOC(IT,IB)
02800		I=230
02900		J=506
03000		LB=250
03100		DO 5 K=1,2
03200		L=255
03300		IB=236
03400		JB=456
03500		DO 6 M=1,2
03600		CALL ALINE(I,L,J,L)
03700	C   HORIZANTAL LINES
03800		CALL ALINE(LB,IB,LB,JB)
03820	C   VERTICAL LINES
03822		DO 7 KB=LB+192,LB+64,-64
03824	7	CALL ALINE(KB,L,KB,IB)
03826	C   SPACE MARKERS ON FUNC DPYS.
03830		IF(K.NE.1.OR.M.NE.1)GO TO 66
03840	C  NEXT SETS UP DOPPLER DPY GRID
03850		DO 55 KB=1,5
03860	55	CALL ALINE(IDOP(1,KB),IDOP(2,KB),IDOP(3,KB),IDOP(4,KB))
04000	66	L=-441
04100		IB=-460
04200	6	JB=-240
04300		LB=-466
04400		I=-486
04500	5	J=-210
04600	
04700		CALL ALINE(-200,-200,200,200)
04780		CALL ALINE(-200,200,200,-200)
04860	C   MARKS LISTENER POS.
04940	
05020		A=4.
05100		L=0
05180		I=141.4
05260		J=-1
05340	140	IB=141.4*SIND(A)
05420		JB=141.4*COSD(A)
05500		IF(J.GE.0)GO TO 141
05580		CALL ALINE(L,I,IB,JB)
05660	141	A=A+4.
05740		J=J+1
05800		IF(J.EQ.2)J=-1
05822		L=IB
05823		I=JB
05825		IF(A.LT.360.)GO TO 140
05830	C   THE SPEAKER CIRCLE.  MAKES DASHES, EVERY 3RD SEG.
05835	
05895		CALL DPYBRT(5)
05897		CALL DPYBIG(6)
05900		DO 14 K=1,4
06000	14	CALL DPYTXT(ICA(K),ICB(K),ALF(K),1)
06100	
06200		CALL DPYOUT(1)
06250	
06300		DO 777 K=512,1,-1
06350	777	IF(F(5,K).EQ.0)F(5,K)=F(5,K+1)
06420	C  FIXES UP ZERO MULTIPLIERS IN DOPPLER FUNC.
06500	77	M=1
06600		IB=-466
06700		J=256
06750		RM=200.
06800		DO 8 K=NJ,IPAR-1
06810		IF(M.NE.2)GO TO 88
06828		M=5
06840		RM=300.
06843	C  TO ENLARGE DPY OF DOPPLER
06846		IB=-88
06864		J=106
06880	88	JB=F(M,1)*RM+J
06882	C   DRAWS DOPPLER FUNC.
06900		CALL AIVECT(IB,JB)
07000		DO 9 L=2,512,3
07100		I=IB+L/2
07200	C   REDUCES TO FIT 1/4 OF SCREEN
07300		JB=F(M,L)*RM+J
07400	9	CALL AVECT(I,JB)
07500		IF(M.NE.5)GO TO 99
07510		RM=200.
07520		M=2
07540		J=256
07560		IB=250
07570	C  GOES BACK TO DRAW SPKR B FUNC.
07580		GO TO 88
07600	99	M=M+1
07700		IB=250
07800		IF(M.EQ.3)J=-440
07900		IF(M.EQ.4)IB=-466
08000	8	CONTINUE
08100	
08200	CQ	CALL DPYOUT(1)
08400		CALL AIVECT(IPATH(1,1),IPATH(2,1))
08450		KN=5
08500		DO 13 K=2,512,3
08600		I=IPATH(1,K)
08700		JB=IPATH(2,K)
08800		IF(IABS(JB).GT.512.OR.IABS(I).GT.512)GO TO 13
08810		CALL AVECT(I,JB)
08822		IF(K.EQ.191.OR.K.EQ.383)GO TO 131
08823		IF(MOD(K,64)-1)131,131,13
08825	C  PUTS MARK EACH 1/8 OF PATH (NONE AT START)
08830	131	CALL AVECT(I+7,JB)
08840		CALL AVECT(I+7,JB+7)
08841		CALL AVECT(I,JB+7)
08850		CALL AVECT (I,JB)
09050	13	CONTINUE
09100		CALL DPYOUT(1)
09300		TYPE 112
09400		ACCEPT 113,NAME,LB
09420	333	IF(LB.EQ.0)GO TO 130
09440	C   JUMP IF NOT SAVING DPY BUFFER
09460		IP(1)=IP(3)+2
09480	C   IP(3) IS REALLY ISU(2).  I.E. WDCNT
09490		CALL SAVB(IP)
09495	C   WRITES A BINARY FILE OF DPY BUFFER FOR "PLTVEC"
09500	130	IF(NAME.EQ.' ')RETURN
09505	CC130	IF(NAME.EQ.' '.OR.MOD(NL,2).EQ.0)RETURN
09512	CCC  --- THIS IS CHANGED   RETURN IF QUAD OR QUADX(-13,-15)
09520	C  WRITE FUNCS IF QUADF OR QUADFX (-14,-16)
09600		REWIND  23
09700		CALL OFILE(23,NAME)
09800		DO 10 K=1,5
09900		IF(NJ.LT.10)GO TO 100
09950		ARY(3)=5H',I2,
09975		ARY(7)=5HI2,')
10000	100	WRITE(23,ARY)NJ,NJ
10300	101	WRITE(23,12)(F(K,N),N=1,512)
10400	10	NJ=NJ+1
10500		END FILE 23
10520		TYPE 114,NAME
10600		RETURN
10900	12	FORMAT(16F8.5/)
11000	112	FORMAT(' TYPE FILE NAME TO SAVE FUNCS --  '$)
11100	113 	FORMAT(A5,I)
11120	114	FORMAT(' FUNCTIONS ARE IN ',A5,'.DAT'/)
11200		END